#!/usr/bin/perl

use warnings;
use strict;

$SIG{PIPE} = 'IGNORE';    # otherwise, SIGPIPE terminates the proxy.

use POE;
use POE::Component::Server::TCP;
use POE::Component::Client::HTTP;
use POE::Filter::HTTPD;

use FindBin;
use lib "$FindBin::Bin";
use HTTP::Response;
use HTTP::Headers::Util;
use HTML::FormParser;
use bytes;

use CGI qw//;
use LWP::UserAgent qw//;
use YAML qw//;
use Encode qw//;
use File::Basename qw//;
use MIME::Base64 qw//;
use Data::Dumper;

sub DUMP_REQUESTS ()  { 1 }
sub DUMP_RESPONSES () { 0 }
sub LISTEN_PORT ()    { 8080 }
sub APP_URI_REGEXP () { 'http:\/\/localhost:4000' }
sub APP_TXT_ENCODE () { 'utf8' }
sub PROVA_SERVER ()   { 'http://localhost:3000/recorder' }

sub HTTP::Response::decoded_content {
    my ( $self, %opt ) = @_;
    $opt{charset} = 'none';
    $self->SUPER::decoded_content(%opt);
}

### Spawn a web client to fetch requests through.
POE::Component::Client::HTTP->spawn( Alias => 'ua' );

### Spawn a web server.

# The ClientInput function is called to deal with client input.
# ClientInput's callback function will receive entire HTTP requests
# because this server uses POE::Filter::HTTPD to parse its input.
#
# InlineStates let us attach our own events and handlers to a TCP
# server.  Here we attach a handler for the got_response event, which
# will be sent to us by Client::HTTP when it has fetched something.

POE::Component::Server::TCP->new(
    Alias        => "web_server",
    Port         => LISTEN_PORT,
    ClientFilter => 'POE::Filter::HTTPD',
    ClientInput  => \&handle_http_request,
    InlineStates => { got_response => \&handle_http_response, },
);

### Display current settings.

display_thing(
    sprintf(
        "DUMP_REQUESTS = %s\nDUMP_RESPONSES = %s\nLISTEN_PORT = %s\nAPP_URI_REGEXP = %s\nAPP_TXT_ENCODE = %s\nPROVA_SERVER = %s\n",
        DUMP_REQUESTS  ? 'YES' : 'NO',
        DUMP_RESPONSES ? 'YES' : 'NO',
        LISTEN_PORT, APP_URI_REGEXP, APP_TXT_ENCODE, PROVA_SERVER
    )
);

### Run the proxy until it is done, then exit.

POE::Kernel->run();
exit 0;

### Handle HTTP requests from the client.  Pass them to the HTTP
### client component for further processing.  Optionally dump the
### request as text to STDOUT.

sub handle_http_request {
    my ( $kernel, $heap, $request ) = @_[ KERNEL, HEAP, ARG0 ];

    # If the request is really a HTTP::Response, then it indicates a
    # problem parsing the client's request.  Send the response back so
    # the client knows what's happened.
    if ( $request->isa("HTTP::Response") ) {
        $heap->{client}->put($request);
        $kernel->yield("shutdown");
        return;
    }

    # Client::HTTP doesn't support keep-alives yet.
    $request->header( "Connection",       "close" );
    $request->header( "Proxy-Connection", "close" );
    $request->header( "X-Forwarded-For",  $heap->{'remote_ip'} );
    $request->remove_header("Keep-Alive");

    #display_thing( $request->as_string() ) if DUMP_REQUESTS;
    &register_prova( $kernel, $heap, $request );

    $kernel->post( "ua" => "request", "got_response", $request );
}

### Register datas to Prova server.
### - remote ip address, uri and get or post method
### - get and post parameters and uploaded files

sub register_prova {
    my ( $kernel, $heap, $request ) = @_;

    my $uri = $request->uri->as_string;
    my $app = APP_URI_REGEXP;

    if ( $uri =~ /$app/ and $uri !~ /\/static/ ) {
        display_thing( "remote => " . $heap->{'remote_ip'} . "\nuri => " . $uri . "\nmethod => " . $request->method . "\n" ) if DUMP_REQUESTS;

        my $params;
        if ( $request->parts ) {
            my @parts = $request->parts;
            foreach my $p (@parts) {
                my %hash;
                my @list = HTTP::Headers::Util::split_header_words( $p->header('content-disposition') );
                foreach (@list) {
                    while ( scalar @{$_} ) {
                        my $key = shift @{$_};
                        my $val = shift @{$_};
                        $hash{$key} = $val;
                    }
                }
                if ( $hash{'filename'} ) {
                    $params->{ 'section_' . $hash{'name'} } = $hash{'filename'};

                    # create file object
                    my $size = bytes::length( $p->content );
                    my $body = MIME::Base64::encode_base64( $p->content );
                    File::Basename::fileparse_set_fstype('MSWin32');
                    my ( $filename, $dirname ) = File::Basename::fileparse( $hash{'filename'} );
                    File::Basename::fileparse_set_fstype('Unix');
                    my ($extention) = ( $filename =~ /.([^.]*)$/ );
                    $filename =~ s/.([^.]*)$//g;
                    my $file = {
                        name      => $filename,
                        extention => $extention,
                        size      => $size,
                        body      => $body
                    };

                    $params->{ 'upload_' . $hash{'name'} } = YAML::Dump $file;
                }
                else {
                    $params->{ 'section_' . $hash{'name'} } = $p->content;
                }
            }
        }
        else {
            my $query = CGI->new( $request->content );
            my @param = $query->param();
            foreach (@param) {
                $params->{ 'section_' . $_ } = $query->param($_);
            }
        }

        # convert request parameters to YAML datas
        for my $key ( keys %{$params} ) {
            if ( ref $params->{$key} eq 'ARRAY' ) {
                for ( my $i = 0 ; $i < scalar @{ $params->{$key} } ; $i++ ) {
                    if ( APP_TXT_ENCODE ne 'utf8' ) {
                        Encode::from_to( $params->{$key}->[$i], APP_TXT_ENCODE, 'utf8' );
                    }
                }
            }
            else {
                if ( APP_TXT_ENCODE ne 'utf8' ) {
                    Encode::from_to( $params->{$key}, APP_TXT_ENCODE, 'utf8' );
                }
            }
            $params->{$key} = YAML::Dump $params->{$key};
        }

        # other necessary parameters
        $params->{host} = $heap->{'remote_ip'};
        $uri =~ s/$app//g;
        $params->{block_path} = $uri;
        $params->{block_method} = $request->method() eq 'GET' ? 1 : 2;

        display_thing( Dumper $params ) if DUMP_REQUESTS;

        # post datas to Prova server
        # my $ua = LWP::UserAgent->new();
        $heap->{'tmp_params'} = $params;
    }
}

### Handle HTTP responses from the POE::Component::Client::HTTP we've
### spawned at the beginning of the program.  Send each response back
### to the client that requested it.  Optionally display the response
### as text.

sub handle_http_response {
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];

    my $http_response = $_[ARG1]->[0];

    my $response_type = $http_response->content_type();
    if ( $response_type =~ /^text/i ) {
        display_thing( $http_response->as_string() ) if DUMP_RESPONSES;

        my $hf = HTML::FormParser->new;
        $hf->parse( $http_response->as_string() );
        $hf->eof;
        my $tmp_params = $heap->{'tmp_params'};
        $tmp_params->{'query'} = YAML::Dump $hf->result;
        Encode::from_to( $tmp_params->{'query'}, APP_TXT_ENCODE, 'utf8' );

        my $ua = LWP::UserAgent->new();
        my $response = $ua->post( PROVA_SERVER, $tmp_params );

    }
    else {
        print "Response wasn't text.\n" if DUMP_RESPONSES;
    }

    $http_response->header( 'Content-Length', bytes::length( $http_response->content ) );

    # Avoid sending the response if the client has gone away.
    $heap->{client}->put($http_response) if defined $heap->{client};

    # Shut down the client's connection when the response is sent.
    $kernel->yield("shutdown");
}

### Display requests and responses with brackets around them so they
### stand apart.

sub display_thing {
    my $thing = shift;
    $thing =~ s/^/| /mg;
    print ",", '-' x 78, "\n";
    print $thing;
    print "`", '-' x 78, "\n";
}
